home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / datamgr / module1.bas < prev    next >
BASIC Source File  |  1995-10-23  |  15KB  |  505 lines
  1. Option Explicit
  2.  
  3. Global gDatabase As database   'Current Database
  4. Global gDatabaseName As String
  5. Global gDatabaseForm As Form
  6. Global gDatabaseType As String
  7.  
  8. Function addField (table, FName, fType, FSize, FCounter)
  9.  
  10.     Dim f As New field
  11.  
  12.     On Error Resume Next
  13.  
  14.     addField = True
  15.     f.Name = FName
  16.     f.type = fType
  17.     f.size = TypeToSize(fType, FSize)
  18.     If fType = 4 And FCounter = 1 Then f.Attributes = 16
  19.     
  20.     gDatabase.TableDefs.Refresh
  21.     If Err <> 0 Then
  22.         MsgBox "Error During Refresh Attempt:" + Chr$(13) + Error$, 64, "Data Manager"
  23.         addField = False
  24.         Exit Function
  25.     End If
  26.  
  27.     gDatabase.TableDefs(table).Fields.Refresh
  28.     If Err <> 0 Then
  29.         MsgBox "Error During Refresh Attempt:" + Chr$(13) + Error$, 64, "Data Manager"
  30.         addField = False
  31.         Exit Function
  32.     End If
  33.  
  34.     gDatabase.TableDefs(table).Fields.Append f
  35.     If Err <> 0 Then
  36.         MsgBox "Error During Add Field Attempt:" + Chr$(13) + Error$, 64, "Data Manager"
  37.         addField = False
  38.         Exit Function
  39.     End If
  40.     
  41.     
  42. End Function
  43.  
  44. Function AddTable (x As String, FName, fType, FSize, FCounter)
  45.  
  46.     Dim td As New tabledef
  47.     Dim f As New field
  48.     Dim bInvalid As Integer
  49.  
  50.     On Error Resume Next
  51.     AddTable = True
  52.     
  53.     f.Name = FName
  54.     f.type = fType
  55.     f.size = TypeToSize(fType, FSize)
  56.     If fType = 4 And FCounter = 1 Then f.Attributes = 16
  57.     td.Fields.Append f
  58.  
  59.   
  60.  ' Do
  61.     bInvalid = False
  62.     If x = "" Or bInvalid = True Then
  63.         x = InputBox("Table Name:", "Create New Table")
  64.     End If
  65.  
  66.     If x <> "" Then
  67.         td.Name = x
  68.         gDatabase.TableDefs.Append td
  69.         If Err <> 0 Then
  70.             MsgBox "Error During Attempt to Create Table:" + Chr$(13) + Error$, 64, "Data Manager"
  71.             x = ""
  72.          '   If Err = 3010 Or Err = 3125 Then
  73.          '       bInvalid = True
  74.          '   Else
  75.                 AddTable = False
  76.                 Exit Function
  77.          '   End If
  78.         Else
  79.             RefreshDatabaseWindow
  80.         End If
  81.         
  82.     Else
  83.         AddTable = False
  84.     End If
  85.  ' Loop While bInvalid = True
  86. End Function
  87.  
  88. 'returns true if database is closed
  89. Function CloseCurrentDatabase ()
  90.  
  91.     'Used for loop through forms
  92.     Dim i, max, temp, abort As Integer
  93.     
  94.     
  95.     'If there is no database open, return true
  96.     If gDatabaseName = "" Then
  97.         CloseCurrentDatabase = True
  98.     Else
  99.         'Unload all query and tabledef forms
  100.  
  101.         max = forms.Count - 1
  102.         i = 0
  103.         abort = False
  104.         Do While i <= max
  105.             If forms(i).Tag <> "Main" And forms(i).Tag <> "Database" Then
  106.                 temp = forms.Count
  107.                 Unload forms(i)
  108.                 If temp = forms.Count Then
  109.                     abort = True
  110.                     Exit Do
  111.                 End If
  112.                 max = max - 1
  113.             Else
  114.                 i = i + 1
  115.             End If
  116.         Loop
  117.  
  118.         'If all query and tabledef forms closed, and the user didn't abort,
  119.         'close the database and return Success, else return Failure
  120.         If forms.Count = 2 And Not abort Then
  121.             Unload gDatabaseForm
  122.             CloseCurrentDatabase = True
  123.         Else
  124.             CloseCurrentDatabase = False
  125.         End If
  126.     End If
  127.             
  128.  
  129. End Function
  130.  
  131. Sub OpenADatabase (cmdialog As Control, dataBaseType As String)
  132.  
  133.       
  134.     On Error Resume Next
  135.  
  136.     Dim x As String
  137.     Dim stgpos As Integer
  138.  
  139.     gDatabaseType = dataBaseType
  140.  
  141.     If dataBaseType = "ODBC" Then    'Make ODBC Menu visible
  142.         Set gDatabase = OpenDatabase("", 0, 0, "odbc;")
  143.         If Err = 3059 Then
  144.             Exit Sub
  145.         ElseIf Err <> 0 Then
  146.             MsgBox "Could Not Connect:" + Chr$(13) + Error$, 64, "Data Manager"
  147.             Exit Sub
  148.         End If
  149.         x = "ODBC"
  150.         stgpos = InStr(gDatabase.Connect, "DATABASE=")
  151.         If stgpos > 0 Then x = Mid$(gDatabase.Connect, stgpos + 9)
  152.         gDatabaseName = x
  153.         OpenDatabaseWindow x
  154.     ElseIf dataBaseType = "Access" Then
  155.             cmdialog.DefaultExt = "mdb"
  156.             cmdialog.Filename = ""
  157.             cmdialog.DialogTitle = "Open Database"
  158.             cmdialog.CancelError = True
  159.             cmdialog.Filter = "Access (*.mdb)|*.mdb|All Files (*.*)|*.*|"
  160.             cmdialog.Flags = &H4& Or &H1000& 'remove readonly checkbox
  161.             
  162.             cmdialog.Action = 1
  163.             If Err <> 32755 Then
  164.                 Set gDatabase = OpenDatabase(cmdialog.Filename)
  165.                 If Err <> 0 Then
  166.                     MsgBox "Could Not Open Database:" + Chr$(13) + Error$, 64, "Data Manager"
  167.                     Exit Sub
  168.                 Else
  169.                     'This next line used to read gDatabaseName=gDatabase.Name
  170.                     'but this didn't include the path of the file.
  171.                     gDatabaseName = cmdialog.Filename
  172.                     x = cmdialog.Filetitle
  173.                     OpenDatabaseWindow gDatabaseName
  174.                 End If
  175.             End If
  176.     ElseIf dataBaseType = "Btrieve" Then
  177.             cmdialog.Filename = ""
  178.             cmdialog.DefaultExt = "ddf"
  179.             cmdialog.DialogTitle = "Open Database"
  180.             cmdialog.CancelError = True
  181.             cmdialog.Filter = "Btrieve (*.ddf)|*.ddf|All Files (*.*)|*.*|"
  182.             cmdialog.Flags = &H4& Or &H1000&  'remove readonly checkbox
  183.             
  184.             cmdialog.Action = 1
  185.             If Err <> 32755 Then
  186.                 Set gDatabase = OpenDatabase(cmdialog.Filename, 0, 0, "btrieve")
  187.                 If Err <> 0 Then
  188.                     MsgBox "Could Not Open Database:" + Chr$(13) + Error$, 64, "Data Manager"
  189.                     Exit Sub
  190.                 Else
  191.                     'This next line used to read gDatabaseName=gDatabase.Name
  192.                     'but this didn't include the path of the file.
  193.                     gDatabaseName = cmdialog.Filename
  194.                     x = cmdialog.Filetitle
  195.                     OpenDatabaseWindow gDatabaseName
  196.                 End If
  197.             End If
  198.     Else
  199.         Load OpenDBForm
  200.         OpenDBForm.Label1 = "Pick Your " + gDatabaseType + " Directory:"
  201.         OpenDBForm.Show 1
  202.         If OpenDBForm.ExitCondition = "OK" Then
  203.             x = OpenDBForm.Dir1
  204.             If Right(x, 1) <> "\" Then x = x + "\"
  205.             Set gDatabase = OpenDatabase(x, 0, 0, dataBaseType + ";")
  206.             If Err <> 0 Then
  207.                 MsgBox "Could Not Open Database:" + Chr$(13) + Error$, 64, "Data Manager"
  208.                 Exit Sub
  209.             Else
  210.                 gDatabaseName = gDatabase.Name
  211.                 x = OpenDBForm.Dir1
  212.                 OpenDatabaseWindow x
  213.             End If
  214.         End If
  215.     End If
  216.  
  217. End Sub
  218.  
  219. Sub OpenDatabaseWindow (title As Variant)
  220.     Dim x As New dbForm
  221.     
  222.     Set gDatabaseForm = x
  223.     x.Caption = "Database: " + title
  224.     'gDatabaseName = title
  225.     RefreshDatabaseWindow
  226.     gDatabaseForm.Show
  227.     
  228.     
  229. End Sub
  230.  
  231. Sub OpenNewDatabase (cmdialog As Control, Verfmt As Integer)
  232. 'VerFmt=0 means Access 1.1
  233. 'VerFmt=1 means Access 1.0
  234.  
  235.     On Error Resume Next
  236.     cmdialog.DefaultExt = "mdb"
  237.     cmdialog.DialogTitle = "New Database"
  238.     cmdialog.Filename = ""
  239.     cmdialog.CancelError = True
  240.     cmdialog.Filter = "Access (*.mdb)|*.mdb|All Files (*.*)|*.*|"
  241.     cmdialog.Flags = &H4&
  242.  
  243.     cmdialog.Action = 2
  244.     If Err <> 32755 Then
  245.         Set gDatabase = CreateDatabase(cmdialog.Filename, ";LANGID=0x0809;CP=1252;COUNTRY=0", Verfmt)
  246.         If Err <> 0 Then
  247.             MsgBox "Could Not Create Database:  " + Chr$(13) + Error$, 64, "Data Manager"
  248.             Exit Sub
  249.         End If
  250.  
  251.         gDatabaseName = cmdialog.Filename
  252.         
  253.         OpenDatabaseWindow (UCase(cmdialog.Filetitle))
  254.     End If
  255.  
  256. End Sub
  257.  
  258. Sub OpenNewTableDesign ()
  259.     On Error Resume Next
  260.  
  261.     Dim sTableName As String
  262.  
  263.     sTableName = InputBox("Table Name:", "Create New Table")
  264.     If sTableName = "" Then Exit Sub
  265.     
  266.     'Check to see if table already exists
  267.     D